home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / MYPROGS.ZIP / NIBBLER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-06  |  4.4 KB  |  189 lines
  1. program CHENILLETTE;
  2. uses crt;
  3. const nbl=75;
  4.       nbc=25;
  5.       gauche='1';
  6.       droite='2';
  7.       haut='9';
  8.       bas='6';
  9.       limx=100;
  10.       limy=100;
  11.       gx=5;
  12.       gy=5;
  13.       ecran=$B800;
  14.       rapidite=500;
  15.  
  16.  
  17. type Tableau=array[1..limx,1..limy] of byte;
  18.      CHENILLE=array[1..300] of byte;
  19.  
  20. var x,y,corps,i,j,dir,dirx,diry: byte;
  21.                 t: Tableau;
  22.                 a: char;
  23.              test: boolean;
  24.             tx,ty:chenille;
  25.                 f:text;
  26.             ligne:string;
  27.               nom:string;
  28.               boucle: integer;
  29.  
  30.  
  31. PROCEDURE LECTURE;
  32. BEGIN
  33.   nom:='decor.bak';
  34.   assign(f,Nom);
  35.   reset(f);
  36.   i:=0;
  37.   while NOT eof(f) do
  38.       BEGIN
  39.         i:=i+1;
  40.         readln(f,ligne);
  41.         for j:=1 to length(ligne) do
  42.                    BEGIN
  43.                      if ligne[j]=' ' then t[j,i]:=0
  44.                      else
  45.                        t[j,i]:=ord(ligne[j])-ord('0');
  46.                    END;
  47.       END;
  48.   close(f);
  49. END;
  50.  
  51.  
  52. PROCEDURE AFF(var t:tableau);
  53. var xgraf,ygraf:byte;
  54. BEGIN
  55.   for i:=1 to nbl do
  56.   BEGIN
  57.   ygraf:=0;
  58.     for j:=1 to nbc do
  59.       BEGIN
  60.  
  61.         if x<nbl div 2 then xgraf:=i else xgraf:=i+x-(nbl div 2);
  62.         if y<nbc div 2 then ygraf:=ygraf+1 else ygraf:=j+y-(nbc div 2);
  63.         if x>limx-(nbl div 2)-1 then xgraf:=limx-nbl+i;
  64.         if y>limy-(nbc div 2)-1 then ygraf:=limy-nbc+j;
  65.         CASE t[xgraf,ygraf] of
  66.            0: mem[ecran:(j*80+i)*2]:=32;
  67.            3: BEGIN
  68.               mem[ecran:(j*80+i)*2+1]:=2;
  69.               mem[ecran:(j*80+i)*2]:=162;
  70.               END;
  71.            2:BEGIN
  72.                mem[ecran:(j*80+i)*2+1]:=8;
  73.                mem[ecran:(j*80+i)*2]:=219;
  74.              END;
  75.            1: BEGIN
  76.                 mem[ecran:(j*80+i)*2+1]:=12;
  77.                 mem[ecran:(j*80+i)*2]:=ord('@');
  78.               END;
  79.         END;
  80.       END;
  81.   END;
  82. END;
  83.  
  84.  
  85. FUNCTION COLLISION(x,y:byte;tx,ty:chenille):boolean;
  86. BEGIN
  87.  CASE dir OF
  88.     0: tX[1]:=tX[1]+1;
  89.     1: tY[1]:=tY[1]+1;
  90.     2: tX[1]:=tX[1]-1;
  91.     3: tY[1]:=tY[1]-1;
  92.   END;
  93.  if t[tx[1],ty[1]]<>0 then collision:=true else collision:=false;
  94. END;
  95.  
  96. PROCEDURE RENCONTRE(var x,y:byte);
  97. BEGIN
  98.   if dir=3 then dir:=0 else dir:=dir+1;
  99.     if collision(x,y,tx,ty) then
  100.                            BEGIN
  101.                              CASE dir of
  102.                                0: dir:=2;
  103.                                1: dir:=3;
  104.                                2: dir:=0;
  105.                                3: dir:=1;
  106.                              END;
  107.                              if collision(x,y,tx,ty) then test:=false
  108.                                  else BEGIN
  109.                                          x:=tx[1];y:=ty[1];
  110.                                       END;
  111.                            END
  112.   else BEGIN
  113.          x:=tx[1];y:=ty[1];
  114.        END;
  115. END;
  116.  
  117. PROCEDURE DIRECTION(var dir:byte);
  118. BEGIN
  119.   if a=droite then dir:=0;
  120.   if a=gauche then dir:=2;
  121.   if a=haut then dir:=3;
  122.   if a=bas then dir:=1;
  123. END;
  124.  
  125. PROCEDURE MODIFTAB(var t: tableau);
  126. BEGIN
  127.   CASE dir OF
  128.     0: X:=X+1;
  129.     1: Y:=Y+1;
  130.     2: X:=X-1;
  131.     3: Y:=Y-1;
  132.   END;
  133.   if (t[x,y]<>0) and (t[x,y]<>3) then BEGIN
  134.                        RENCONTRE(x,y);
  135.                        if not test then halt;
  136.                     END
  137.      else
  138.  
  139.      if (t[x,y]=3) and (corps<300) then corps:=corps+1;
  140.      for i:=corps downto 2 do BEGIN
  141.                                 tx[i]:=tx[i-1];
  142.                                 ty[i]:=ty[i-1];
  143.                                END;
  144.       tx[1]:=x;
  145.       ty[1]:=y;
  146.       t[tx[corps],ty[corps]]:=0;
  147.       t[x,y]:=1;
  148. END;
  149.  
  150. BEGIN
  151.   writeln('les touches sont:');
  152.   writeln('    gauche:1');
  153.   writeln('    droite:2');
  154.   writeln('    haut:9');
  155.   writeln('    bas:6');
  156.   writeln('    q:quitter');
  157.   readkey;
  158.   clrscr;
  159.   LECTURE;
  160.   x:=10;
  161.   y:=50;
  162.   t[x,y]:=1;
  163.   a:=' ';
  164.   dir:=2;
  165.   test:=true;
  166.   corps:=4;
  167.   tx[1]:=x;ty[1]:=y;tx[2]:=x;ty[2]:=y-1;tx[3]:=x;ty[3]:=y-2;
  168.   AFF(t);
  169.   boucle:=0;
  170.   while (a<>'q') or (not test) do
  171.      BEGIN
  172.        inc(boucle);
  173.        if (not(keypressed)) and (boucle=rapidite) then
  174.           BEGIN
  175.             boucle:=0;
  176.             MODIFTAB(t);
  177.             AFF(t);
  178.           END
  179.        else
  180.          if keypressed then
  181.            BEGIN
  182.             if boucle=rapidite then boucle:=0;
  183.             a:=readkey;
  184.             DIRECTION(dir);
  185.            END;
  186.      END;
  187.   {readln;}
  188. END.
  189.